home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbs_mpl.zip / MBS20705.MRG < prev    next >
Text File  |  1992-07-05  |  66KB  |  1,675 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB2.BAS to produce E:\RBBS\CHAT\RBBSSUB2.BAS
  3. * E:\RBBS\STOCK\RBBSSUB2.BAS:  Date 6-20-1992  Size 140946 bytes
  4. * ------------[ Created 07-05-1992 07:15:25 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB2.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB2.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  Macro          1320  Check/execute macro
  23. '  AnswerIt        200  Answer the telephone when it rings
  24. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  25. '  BadChar         455  Check user name for invalid characters
  26. '  BadName       20235  Check for system crash attempt with bad file name
  27. '  BankTime       5500  Let caller change banked time
  28. '  CheckRatio    20096  Test upload/download ratio
  29. '  CheckMacro     1242  Checks for macro and processes
  30. '  CopyRight        97  Display RBBS-PC's copyright notice
  31. '  DEFALTU        9600  Write out the user's defaults
  32. '  DenyAccess     1386  Downgrade security so access denied
  33. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  34. * ------[ first line different ]------
  35. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  36. '  EditALine      2618  Edits a single line
  37. '  EditDef         120  Edit configuration parameters
  38. '  FileNameCheck 20240  Matches file name to a prefix & extension
  39. '  GetArc        20140  Handle request for verbose listing
  40. '  GetCommand      101  Get RBBS-PC's node id from command line
  41. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  42. '  GoIdle           90  Release resources when waiting for keyboard input
  43. '  KillMsg        3952  Delete old or unnecessary messages
  44. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  45. '  LineEdit       3700  Edit a line while minimizing string space consumption
  46. '  LogError      13660  Log error message to CALLERS file
  47. '  LPrnt          1480  Subroutine to write to local display
  48. '  MLInit            8  Removed in Maple code
  49. '  MsgProt        2055  Sets protection for a message
  50. '  ParseIt        1637  Parses a string
  51. '  PassWrd         660  Verify user & message passwords
  52. '  PopCmdStack    1650  Get user input, 1st checking command stack
  53. '  PScrn          1483  Print to display
  54. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  55. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  56. '  QuickTPut1     1478  Outputs short string following by CR LF
  57. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  58. '  RecoverMsg    10410  Recover a deleted message
  59. '  RemNonAlf      5100  Removes non-alpha characters from a string
  60. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  61. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  62. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  63. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  64. '  SetThread      4554  Set up request for threading thru messages
  65. '  SetWhoTo       2018  Sets who a message/personal upload is to
  66. '  SkipLine       1485  Write a # of blank lines to the communications port
  67. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  68. '  SecViolation   1380  Process a security violation
  69. '  SysMenu         112  Displays sysop menu/status
  70. '  SysopChat      4773  Sysop and caller chat
  71. '  TestRel         336  Tests for Reliable connect
  72. '  TGet           1498  Read a line from the communications port
  73. '  TPut           1396  Write a line to the communications port
  74. '  Trim            105  Strip leading and trailing blanks from a string
  75. '  TrimTrail       107  Strip off specified string off end of another string
  76. '  UntilRight    12878  Ask a question until user says answer is right
  77. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  78. '  VarInit         109  Initialize system variables
  79. '  ViewHelp       1330  Processes help command
  80. '  WhoCheck       2250  Checks whether a user exists in user file
  81. '  WhosOn         9801  Report status of each node - who's on
  82. '  WordInFile    10976  Find a whole word within a file/menu
  83. '
  84. '  $INCLUDE: 'RBBS-VAR.BAS'
  85. '
  86. * DELETING old line(s)
  87. 10
  88. 20
  89. 30
  90. 60
  91. 70
  92. 80
  93. * REPLACING old line(s) by new
  94. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  95. '  $PAGE
  96. '
  97. '  NAME    -- GoIdle
  98. '
  99. '  INPUTS  -- ZMLCom
  100. '             ZNetworkType
  101. '
  102. '  OUTPUTS --  NONE
  103. '
  104. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  105. '              input from the communications port
  106. '
  107.       SUB GoIdle STATIC
  108. * ------[ first line different ]------
  109.    CALL GiveBack
  110.    END SUB
  111. * REPLACING old line(s) by new
  112. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  113. '  $PAGE
  114. '
  115. '  NAME    -- CopyRight
  116. '
  117. '  INPUTS  --  NONE
  118. '
  119. '  OUTPUTS --  NONE
  120. '
  121. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  122. '
  123.       SUB CopyRight STATIC
  124.    ZWasA = (ZDebug OR ZExitToDoors OR ZCopyrightSecs < 1)
  125.    IF ZWasA THEN _
  126.       EXIT SUB
  127.    WIDTH 80
  128.    ZOutTxt$(1) = "If you use RBBS-PC 17.4, please consider contributing to"
  129. * ------[ first line different ]------
  130.    ZOutTxt$(2) = ""
  131.    ZOutTxt$(3) = "             Capital PC Software Exchange"
  132.    ZOutTxt$(4) = "                 Post Office Box 1785"
  133.    ZOutTxt$(5) = "            West Bethesda, Maryland  20827"
  134.    ZOutTxt$(6) = ""
  135.    ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.4 provided"
  136.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  137.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  138.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  139.    CLS
  140.    KEY OFF
  141.    LOCATE ,,0
  142.    ZWasA = ZSnoop
  143.    ZSnoop = -1
  144.    CALL LPrnt(SPACE$(60) + "tm",1)
  145.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  146.    CALL SkipLine(1)
  147.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  148.    CALL SkipLine (1)
  149.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  150.    FOR WasI = 1 TO 10
  151.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  152.    NEXT
  153.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  154.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-92 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  155.    CALL DelayTime (ZCopyrightSecs)
  156.    ZSnoop = ZWasA
  157.    END SUB
  158. * REPLACING old line(s) by new
  159. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  160. ' $PAGE
  161. '
  162. '  NAME    -- GetCommand
  163. '
  164. '  INPUTS  --     PARAMETER                    MEANING
  165. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  166. '                                  USE AS A MODEL WHEN CREATING THE
  167. '                                  .DEF FILE NAME TO BE USED BY THIS
  168. '                                  COPY OF RBBS-PC.
  169. '
  170. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  171. '                                  RBBS-PC IN THE FORM:
  172. '
  173. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  174. '
  175. '   WHERE THE OPTIONAL PARAMETERS ARE:
  176. '
  177. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  178. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  179. ' DEBUG    IS A DEBUGGING Switch
  180. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  181. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  182. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  183. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  184. '             PROGRAM
  185. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  186. '
  187. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  188. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  189. '
  190. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  191. '                                  THIS COPY OF RBBS-PC TO USE
  192. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  193. '                                  MESSAGES FILE FOR THIS "NODE"
  194. '                                  (RANGE IS 2 TO 36)
  195. '
  196. '  PURPOSE --  To get node id from command line and determine if rbbs
  197. '              is being run as a door
  198. '
  199. * ------[ first line different ]------
  200.       SUB GetCommand (PassedDebug,NetTime$,NetBaud$,NetReliable$) STATIC ' KG031201
  201.       STATIC ZDebug
  202. '
  203. '
  204. ' *  GET NODE ID FROM COMMAND LINE
  205. '
  206. '
  207.       WasPM$ = COMMAND$
  208.       CALL AllCaps(WasPM$)
  209.       IF INSTR(WasPM$,"/") = 0 THEN _
  210.          GOTO 103
  211. '
  212. '
  213. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  214. '
  215. '
  216.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  217.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  218.       ZWasA = 0
  219.       FOR WasX = 1 TO LEN(CmdLine$)
  220.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  221.              ZWasA = ZWasA + 1 : _
  222.              ZSubDir$(ZWasA) = "" _
  223.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  224.       NEXT
  225.       NetTime$ = ZSubDir$(1)
  226.       IF ZWasA > 1 THEN _
  227.          NetBaud$ = ZSubDir$(2)
  228.       IF ZWasA > 2 THEN _
  229.          ZCBaud$ = STR$(VAL(ZSubDir$(3)))       'Pe 031692
  230.       IF ZWasA > 3 THEN _
  231.          NetReliable$ = ZSubDir$(4)              'lk 022792
  232.       CALL Trim(NetTime$)
  233.       CALL Trim(NetBaud$)
  234.       CALL Trim (ZCBaud$)
  235.       CALL Trim(NetReliable$)
  236. * REPLACING old line(s) by new
  237. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  238. '  $PAGE
  239. '
  240. '  NAME    --  VarInit
  241. '
  242. '  INPUTS  --  PARAMETER           MEANING
  243. '              NONE
  244. '
  245. '  OUTPUTS --  NONE
  246. '
  247. '  PURPOSE --  To initialize system variable
  248. '
  249.       SUB VarInit STATIC
  250.     DEF SEG                            ' Point to BASIC
  251.     WIDTH 80                           ' Set Screen Width
  252.     KEY OFF                            ' Line 25 turned off
  253. ' ********************* Variable Definitions *******************************
  254.     ZMsgDim = 99
  255.     WasMM = 999
  256.     WasBX = 75
  257.     WasJ = 60
  258.     REDIM ZOptSec(WasJ)
  259.     DIM ZWorkAra$(WasJ)
  260.     DIM ZGSRAra$(WasJ)
  261.     DIM ZCategoryName$(WasBX),ZCategoryCode$(WasBX),ZCategoryDesc$(WasBX)
  262.     DIM ZOutTxt$(ZMsgDim)                      ' Message line table
  263.     DIM ZUserIn$(ZMsgDim)                      ' Message line table
  264.     DIM ZMsgPtr(WasMM,2)                       ' Message pointers
  265.     ZAcknowledge$ = CHR$(6)
  266.     ZAckChar$ = "C" + _
  267.             ZAcknowledge$
  268. * ------[ first line different ]------
  269. '    ZActiveMenu$ = "B"
  270.     ZActiveMenu$ = "|"           'ANSIed243
  271.     ZActiveMessage$ = CHR$(225)
  272.     ZBackSpace$ = CHR$(8) + _
  273.                  CHR$(32) + _
  274.                  CHR$(8)
  275.     ZBackArrow$ = CHR$(29) + _
  276.                   CHR$(32) + _
  277.                   CHR$(29)
  278.     ZBaudRates$ = "      300  450 1200 2400 4800 7200 96001200014400168001920038400"
  279.     ZBellRinger$ = CHR$(7)
  280.     ZBulletinMenu$ = ""
  281.     ZWasCL = 24
  282.     ZCancel$ = CHR$(24)
  283.     ZColorReset$ = CHR$(27) + _
  284.                    "[00;37;40m"
  285.     ZConfigFileName$ = "RBBS-PC.DEF"
  286.     ZCarriageReturn$ = CHR$(13)
  287.     ZDeletedMsg$ = CHR$(226)
  288.     ZEndTransmission$ = CHR$(4)
  289.     ZEscape$ = CHR$(27)
  290.     ZExpectActiveModem = 0
  291.     ZFalse = 0
  292.     ZF1Key = 59
  293.     ZF10Key = 68
  294.     ZConfName$ = "MAIN"
  295.     CALL SetHiLite (ZTrue)
  296.     ZHomeConf$ = ""
  297.     ZInConfMenu = -1
  298.     ZLastCommand$ = "M "
  299.     ZLimitMinsPerSession = 0
  300.     ZLineFeed$ = CHR$(10)
  301.     ZLineFeeds = NOT ZFalse
  302.     ZLineEditChk$ = CHR$(9) + _
  303.                     ZLineFeed$ + _
  304.                     CHR$(11) + _
  305.                     CHR$(12) + _
  306.                     CHR$(127) + _
  307.                     CHR$(8) + _
  308.                     ZBellRinger$ + _
  309.                     CHR$(26) + _
  310.                     CHR$(227)
  311.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  312.     ZLockStatus$ = "UM UU UB UD"
  313.     ZMenuIndex = 2
  314.     ZNAK$ = CHR$(21)
  315.     ZNoAdvance = ZFalse
  316.     ZPageLength = 23
  317.     ZParseOff = ZFalse
  318.     ZPressEnter$ = " (Press [ENTER] to quit)"
  319.     ZPressEnterExpert$ = " ([ENTER] quits)"
  320.     ZPressEnterNovice$ = ZPressEnter$
  321.     ZPrivateDoor = ZFalse
  322.     ZRightMargin = 72
  323.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  324.                         ZLineFeed$
  325.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  326.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  327.                    "TY TN BN ND FS LS CN "+ _
  328.                    "C5 C6 C7 C8 C9 CA CB CC CD CE CF"   ' DD061303
  329.     ZStartOfHeader$ = CHR$(1)
  330.     ZTimeLoggedOn$ = SPACE$(8)
  331.     ZTrue = NOT ZFalse
  332.     ZUpInc = -1
  333.     ZXOff$ = CHR$(19)
  334.     ZXOn$ = CHR$(17)
  335.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  336.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  337.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  338.     ZVersionID$ = " Mpl17 /0705
  339.     ZWasLG$(1) = "Registration Check Failed"
  340.     ZWasLG$(2) = "Sysop name attempted"
  341.     ZWasLG$(3) = "Locked out attempt"
  342.     ZWasLG$(4) = "Password Attempt Failed"
  343.     ZWasLG$(5) = "Auto Lockout done"
  344.     ZWasLG$(6) = "Name in use on another Node!"
  345.     ZWasLG$(7) = ""
  346.     ZWasLG$(8) = "Locked reason read!"
  347.     ZWasLG$(9) = "Expired Registration"
  348.     CALL GetCommand (ZDebug,ZNetTime$,ZNetBaud$,ZNetReliable$)
  349.     ZSubParm = 1
  350.     CALL ReadDef (ZConfigFileName$)
  351.     REDIM ZWorkAra$(ZMaxWorkVar)
  352.     REDIM ZGSRAra$(ZMaxWorkVar)
  353.     ZUseTPut = (ZUpperCase OR ZXOnXOff)
  354.     ZOrigCallers$ = ZCallersFile$
  355.     ZOrigMsgFile$ = ZMainMsgFile$
  356.     ZOrigUserFile$ = ZMainUserFile$
  357.     ZOrigSysopFN$ = ZSysopFirstName$
  358.     ZOrigSysopLN$ = ZSysopLastName$
  359.     ZPromptBell = ZPromptBellDef
  360.     ZSecretName$ = ZSysopPswd1$ + " " + ZSysopPswd2$
  361.     IF NOT ZSubBoard THEN _                           'lk 022092 for toss mod
  362.     ZOrigRBBSName$ = ZRBBSName$                       'lk 022092 for toss mod
  363.     END SUB
  364. '
  365. * REPLACING old line(s) by new
  366. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  367. '  $PAGE
  368. '
  369. '  NAME    --  SysMenu
  370. '
  371. '  INPUTS  --  PARAMETER           MEANING
  372. '
  373. '  OUTPUTS --  NONE
  374. '
  375. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  376. '
  377.     SUB SysMenu STATIC
  378.     ZLocalUser = ZTrue
  379.     ZSnoop = ZTrue
  380.     ZNonStop = ZTrue
  381.     CALL CheckTime (TIMER, ZDelay!, 1)
  382.     CLS
  383.     ZStopInterrupts = ZTrue
  384.     ZBypassTimeCheck = ZTrue
  385.     CALL BufFile ("MENU0",WasX)
  386.     ZNonStop = ZFalse
  387.     ZBypassTimeCheck = ZFalse
  388.     ZLocalUser = ZFalse
  389.     IF NOT ZOK THEN _
  390.        CALL LPrnt("MENU0 not on default drive",1)
  391. * ------[ first line different ]------
  392.     LOCATE 2,13
  393.     CALL LPrnt(LEFT$(ZVersionID$,13),0)
  394.     LOCATE 2,42
  395.     CALL LPrnt(ZNodeID$,0)
  396.     LOCATE 2,60
  397.     WasX$ = DATE$
  398.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  399.     LOCATE 2,74
  400.     CALL LPrnt(LEFT$(TIME$,5),0)
  401.     IF ZFMSDirectory$ <> "" THEN _
  402.        LOCATE 6,76 : _
  403.        CALL LPrnt("YES",0)
  404.     IF ZExtendedLogging THEN _
  405.        LOCATE 8,76 : _
  406.        CALL LPrnt("YES",0)
  407.     IF ZFossil THEN _
  408.        LOCATE 10,76 : _
  409.        CALL LPrnt("YES",0)
  410.     LOCATE 12,75 : _
  411.     CALL LPrnt(ZComPort$,0)
  412.     LOCATE 14,75
  413.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  414.     IF ZDebug THEN _
  415.        LOCATE 22,76 : _
  416.        CALL LPrnt("Yes",0)
  417.     END SUB
  418. '
  419. * REPLACING old line(s) by new
  420. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  421. '  $PAGE
  422. '
  423. '  NAME    -- EditDef
  424. '
  425. '  INPUTS  --     PARAMETER                    MEANING
  426. '
  427. '  OUTPUTS --                          OUTPUT STRING
  428. '
  429. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  430. '
  431.       SUB EditDef STATIC
  432.       ZAllOpts$ = ZMainCmds$ + _
  433.                   ZFileCmd$ + _
  434.                   ZUtilCmds$ + _
  435.                   ZLibCmds$ + _
  436.                   ZGlobalCmnds$ + _
  437.                   ZSysopCmds$
  438.       ZHelpExtension$ = "." + _
  439.                         ZHelpExtension$
  440.       ZCompressedExt$ = ZDefaultExtension$
  441.       ZWasQ = INSTR(ZDefaultExtension$,".")
  442.       IF ZWasQ > 0 THEN _
  443.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  444.       ZCurDirPath$ = ZDirPath$
  445.       ZTempExpiredSec = ZExpiredSec
  446.       ZBegMain = 1
  447.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  448.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  449.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  450.       ZHelp$(3) = ZHelpPath$ + _
  451.                  ZHelp$(3)
  452.       ZHelp$(4) = ZHelpPath$ + _
  453.                  ZHelp$(4)
  454.       ZHelp$(7) = ZHelpPath$ + _
  455.                  ZHelp$(7)
  456.       ZHelp$(9) = ZHelpPath$ + _
  457.                  ZHelp$(9)
  458.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  459.                      Extension$,ZTrue)
  460.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  461.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  462.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  463.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  464.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  465.      ZDR1$ = ZFG1Def$
  466.      ZDR2$ = ZFG2Def$
  467.      ZDR3$ = ZFG3Def$
  468.      ZDR4$ = ZFG4Def$
  469.      IF ZSubParm = -62 THEN _
  470.         EXIT SUB
  471.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  472.      IF ZLocalUserMode THEN _
  473.         ZRecycleToDos = ZTrue
  474.      ZEchoer$ = ZDefaultEchoer$
  475.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  476.         ZScreenOutMsg$ = ZStartOfHeader$
  477.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  478.      IF ZMaxWorkVar < 13 THEN _
  479.         ZMaxWorkVar = 13
  480. '
  481. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  482. '
  483.     IF ZMainFMSDir$ <> "" THEN _
  484.        ZFMSDirectory$ = ZDirPath$ + _
  485.                         ZMainFMSDir$ + _
  486.                         "." + _
  487.                         ZMainDirExtension$ : _
  488.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  489. * ------[ first line different ]------
  490.     ZUpcatHelp$ = ZHelpPath$ + _
  491.                   ZUpcatHelp$ + _
  492.                   ZHelpExtension$
  493.     IF ZSubDirCount < 1 THEN _
  494.        GOTO 123
  495.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  496.        INPUT #2,ZSubDir$
  497.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  498.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  499.                                  "\" _
  500.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  501.     NEXT
  502.     GOTO 125
  503. * REPLACING old line(s) by new
  504. 126 CLOSE #2
  505. * ------[ first line different ]------
  506.    ' ZSubParm = -10
  507.    ' CALL Carrier
  508.     
  509. '
  510. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  511. '
  512. * REPLACING old line(s) by new
  513. 328 CALL SetBPS (ZBaudTest!,ZBPS)
  514. * ------[ first line different ]------
  515.     IF ZBPS = 0 THEN GOTO 324                                     'Lk 02/28/92
  516. * REPLACING old line(s) by new
  517. 950 IF NOT ZSnoop THEN _
  518.        EXIT SUB
  519.     ZCursorLine = CSRLIN
  520.     ZCursorRow = POS(0)
  521.     ZWasHH = LEN(ZActiveUserName$) + _
  522.          LEN(ZWasCI$) + _
  523.          LEN(ZLine25$) + _
  524. * ------[ first line different ]------
  525.          LEN(STR$(ZUserSecLevel))+ _
  526.          LEN(STR$(INT(MinsRemaining))) + 2              'Pe 05/29/91
  527.         LOCATE 25,1
  528.    IF ZNetworkType = 0 THEN _
  529.         ZLockStatus$ = SPACE$(2) + _                    'Pe 05/29/91
  530.                            LEFT$(ZTimeLoggedOn$,5)      'Pe 05/29/91
  531.     IF ZWasHH > 63 THEN _
  532.        ZWasHH = 0 _
  533.     ELSE _
  534.        ZWasHH = 64 - ZWasHH
  535.     ZLine25Hold$ = ZLine25$ + _
  536.                     SPACE$(ZWasHH) + _
  537.                     STR$(ZUserSecLevel) + _
  538.                     " " + _
  539.                     ZActiveUserName$ + _
  540.                     " " + _
  541.                     ZWasCI$ + _
  542.                     " " + _
  543.                     STR$(INT(MinsRemaining)) + _                  'Dgs-008
  544.                     " " + _
  545.                     ZLockStatus$
  546.     ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$
  547.     IF ZDosANSI THEN _
  548.        ZLine25Hold$ = ZColorReset$ + ZLine25Hold$ + ZEmphasizeOff$
  549.     CALL LPrnt(ZLine25Hold$,0)
  550.     LOCATE ZCursorLine,ZCursorRow
  551.     END SUB
  552. * REPLACING old line(s) by new
  553. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  554. ' $PAGE
  555. '
  556. '  NAME    -- SecViolation
  557. '
  558. '  INPUTS  --     PARAMETER                    MEANING
  559. '
  560. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  561. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  562. '
  563. '  PURPOSE -- Inform caller of security violation, augment count of
  564. '             violations and determine whether too many occurred.
  565. '
  566.      SUB SecViolation STATIC
  567.      CALL FlushKeys
  568.      CALL BufFile (ZSecVioHelp$,WasX)
  569.      IF NOT ZOK THEN _
  570.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  571.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  572.      ZLastIndex = 0
  573. * ------[ first line different ]------
  574.      ZViolationsThisSession = ZViolationsThisSession + 1
  575.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  576.         EXIT SUB
  577. * REPLACING old line(s) by new
  578. 1430 IF ZWasY$ = "" THEN _
  579.         GOTO 1435
  580.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  581.      GOSUB 1476
  582. * ------[ first line different ]------
  583.      GOTO 1435
  584. * REPLACING old line(s) by new
  585. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  586. ' $PAGE
  587. '
  588. '  NAME    -- LPrnt
  589. '
  590. '  INPUTS  -- PARAMETER             MEANING
  591. '             Strng$        STRING TO WRITE OUT
  592. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  593. '
  594. '  OUTPUTS -- NONE
  595. '
  596. '  PURPOSE -- Subroutine to write to the display.
  597. '
  598.       SUB LPrnt (Strng$,NumReturns) STATIC
  599.       IF NOT ZSnoop THEN _
  600.          EXIT SUB
  601.       CALL PScrn (Strng$)
  602. * ------[ first line different ]------
  603.       IF ZUseBASICWrites THEN _
  604.          FOR WasI = 1 TO NumReturns : _
  605.             PRINT : _
  606.          NEXT : _
  607.       ELSE FOR WasI = 1 TO NumReturns : _
  608.               LOCATE ,,1 : _
  609.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  610.               LOCATE ZWasCL,ZWasCC : _
  611.               NEXT
  612.       END SUB
  613. * REPLACING old line(s) by new
  614. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  615.      IF TempElapsed! < 30 THEN _
  616.         IF TempElapsed! <= 0 THEN _
  617.            CALL SkipLine (1) : _
  618.            ZSubParm = -1 : _
  619.            ZNo = ZTrue : _
  620.            ZRet = ZTrue : _
  621.            ZSleepDisconnect = NOT ZAutoLogoffReq : _
  622.            IF ZAutoLogoffReq THEN _
  623.               CALL UpdtCalr ("Auto-logoff",1): _
  624.               EXIT SUB _
  625.            ELSE CALL UpdtCalr ("Sleep disconnect",1) : _
  626.                 EXIT SUB _
  627.         ELSE IF SleepWarn THEN _
  628.                 SleepWarn = ZFalse : _
  629.                 Temp! = TempElapsed! : _
  630. * ------[ first line different ]------
  631.                 ZOutTxt$ = "Auto-Logoff Counter Active..." : _   'Pe 10/20/91
  632.                 CALL RingCaller : _
  633.                 CALL QuickTput ("Press Enter to cancel    ",0) _ 'Pe 10/20/91
  634.              ELSE IF Temp! - TempElapsed! > 1.0 THEN _
  635.                      CALL QuickTPut (ZBackSpace$+ZBackSpace$,0) : _
  636.                      CALL QuickTPut (RIGHT$(STR$(CINT(TempElapsed!)),2),0) : _
  637.                      Temp! = TempElapsed!                 
  638.      CALL FindFKey
  639.      IF ZSubParm < 0 THEN _
  640.         EXIT SUB
  641. * REPLACING old line(s) by new
  642. 1545 WasX$ = ZWasY$
  643.      ZAutoLogoffReq = ZFalse
  644. * ------[ first line different ]------
  645.      'ZAutoEnd = 0                        'Pe 10/21/91
  646.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  647.         GOTO 1635
  648.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  649.         GOTO 1525
  650.      IF ZWasY$ = "^" THEN _
  651.         GOTO 1525
  652.      IF ZWasY$ = ZCarriageReturn$ THEN _
  653.         GOTO 1547 _
  654.      ELSE GOSUB 1550
  655.      IF ZTurboKey < 1 THEN _
  656.         GOTO 1546
  657.      IF ZWasY$ = " " THEN _
  658.         ZWasY$ = ""
  659.      IF ZWasY$ <> "/" THEN _
  660.         ZUserIn$ = ZWasY$ : _
  661.         ZWasY$ = ZCarriageReturn$ : _
  662.         WasX$ = ZWasY$ : _
  663.         GOTO 1547
  664.      ZTurboKey = 0
  665.      GOTO 1525
  666. * REPLACING old line(s) by new
  667. 1550 IF ZLogonActive THEN _
  668.         GOSUB 1549 : _
  669.         ZHidden = (Temp = 2 - (ZLenIndiv > 0 AND ZStartIndiv > 0))
  670.      IF ZHidden THEN _
  671.         IF (WasX$ <> " " AND WasX$ <> ";") THEN _
  672.            WasX$ = "."
  673.      CALL LPrnt(WasX$,0)
  674. * ------[ first line different ]------
  675.               GOTO 1551
  676.      IF ZHidden AND (WasX$ <> " ") THEN _
  677.         WasX$ = "."
  678.      CALL LPrnt(WasX$,0)
  679. * REPLACING old line(s) by new
  680. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  681.      IF ZAutoLogoffReq OR ZWaitExpired THEN _
  682.         ZWaitExpired = ZFalse : _
  683.         IF NOT ZSuspendAutologoff THEN _
  684. * ------[ first line different ]------
  685.            ZAutoLogoff! = TIMER + 15          'Pe 10/20/91
  686.      RETURN
  687. * REPLACING old line(s) by new
  688. 1625 IF LEN(ZUserIn$) < 4 THEN _
  689.         WasX$ = LEFT$(ZUserIn$,3): _
  690.         CALL AllCaps (WasX$) : _
  691.         ZYes = (INSTR("YES",WasX$) = 1) : _
  692. * ------[ first line different ]------
  693.      ZNo = (INSTR("NO",WasX$) = 1 OR WasX$ = "A" OR WasX$ = "Q") : _
  694.         ZReply = (WasX$ = "RE") OR ZReply : _
  695.         ZKillMessage = (WasX$ = "K") OR ZKillMessage
  696.      ZHidden = ZFalse
  697. * REPLACING old line(s) by new
  698. 1638 ZWasDF$ = ZUserIn$
  699.      CALL AllCaps (ZWasDF$)
  700.      IF ZWasDF$ = "NS" THEN _
  701.          ZUserIn$ = "C" : _
  702.          ZNonStop = ZTrue
  703.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  704.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  705. * ------[ first line different ]------
  706. IF ZAutoEnd = 3 THEN _   'Pe 10/20/91
  707.   ZNonStop = ZFalse      'Pe 10/20/91
  708.      GOTO 1642
  709. * REPLACING old line(s) by new
  710. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  711.      ZWasC = ZWasB-ZWasA
  712.      IF ZWasC < 1 THEN _
  713.         ZEOL = ZTrue : _
  714.         ZWasC = 128
  715.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  716.      IF ZWasDF$ = "" THEN GOTO 1641
  717.         ZWasQ = ZWasQ + 1
  718.         ZStoreParseAt = ZStoreParseAt + 1
  719.         ZUserIn$(ZStoreParseAt) = ZWasDF$
  720.         CALL AllCaps(ZWasDF$)
  721.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";")
  722.         IF WasX = 0 THEN GOTO 1641
  723.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC)
  724.      IF ZStoreParseAt > 1 THEN IF INSTR("Jj",ZUserIn$(ZStoreParseAt-1)) THEN _
  725.         ZNonStop = (ZPageLength < 1)
  726. * ------[ first line different ]------
  727. IF ZAutoEnd = 3 THEN _   'Pe 10/20/91
  728.   ZNonStop = ZFalse      'Pe 10/20/91
  729.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4)
  730.            IF ZAutoLogoffReq THEN CALL QuickTPut1 ("Auto-logoff, if successful")
  731.            IF ZWasQ > 0 AND WasX < 7 THEN _
  732.               ZWasQ = ZWasQ - 1 : _
  733.               ZStoreParseAt = ZStoreParseAt - 1
  734. * REPLACING old line(s) by new
  735. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  736. ' $PAGE
  737. '
  738. '  NAME    -- SetBaud
  739. '
  740. '  INPUTS  --     PARAMETER                    MEANING
  741. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  742. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  743. '                                 BAUD RATE TO THE USER'S BAUD
  744. '                                 RATE (INDEPENDENT OF THE BAUD
  745. '                                 RATE USED TO OPEN THE COMM. PORT)
  746. '
  747. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  748. '            RATE              PCjr         PC AND XT
  749. '              50             2237             2304
  750. '              75             1491             1536
  751. '             110             1017             1047
  752. '             134.5            832              857
  753. '             150              746              768
  754. '             300              373              384
  755. '             600              186              192
  756. '            1200               93               96
  757. '            1800               62               64
  758. '            2000               56               58
  759. '            2400               47               48
  760. '            3600               31               32
  761. '            4800               23               24
  762. '            7200          not available         16
  763. '            9600          not available         12
  764. * ------[ first line different ]------
  765. '           14400          not available          8
  766. '           19200          not available          6
  767. '           38400               "                 3
  768. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  769. '
  770. '  PURPOSE -- To set the baud rate in the RS232 interface
  771. '             inpependent of the baud rate the communications port
  772. '             was opened at
  773. '
  774.       SUB SetBaud STATIC
  775.      IF ZCBaud$ = "" THEN _
  776.         ZCBaud$ = MID$(ZBaudRates$,(-5 * ZBPS),5)
  777.      Temp! = VAL(ZCBaud$)
  778.      IF Temp! > 0 THEN CALL SetBPS (Temp!,ZCBPS)
  779.      IF (ZCBPS = 0 OR Temp! = 0) THEN ZCBPS = ZBPS
  780.      IF NOT ZKeepInitBaud THEN _
  781.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  782.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  783.      CALL Trim (ZTalkToModemAt$)
  784.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  785.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  786.                             ZTalkToModemAt$
  787.      IF ZEightBit THEN_
  788.         Parity = 2 : _                                    ' No PARITY
  789.         DataBits = 3 : _                                  ' 8 DATA BITS
  790.         StopBits = 0 _                                    ' 1 STOP BIT
  791.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  792.           DataBits = 2 : _                                ' 7 DATA BITS
  793.           StopBits = 0                                    ' 1 STOP BIT
  794.      ComSpeed! = VAL(ZTalkToModemAt$)
  795.      IF ComSpeed! > 19200 THEN _
  796.         IF ZFossil THEN _
  797.            WasI = &H9600 _
  798.         ELSE WasI = 19200 _
  799.      ELSE WasI = ComSpeed!
  800.      IF ZFossil THEN _
  801.         CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
  802.         EXIT SUB
  803.      IF ComSpeed! = 2400 THEN _
  804.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  805.      ELSE IF ComSpeed! = 1200 THEN _
  806.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  807.      ELSE IF ComSpeed! = 9600 THEN _
  808.         ZBaudRateDivisor = &HC _
  809.      ELSE IF ComSpeed! = 300 THEN _
  810.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  811.      ELSE IF ComSpeed! = 450 THEN _
  812.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  813.      ELSE IF ComSpeed! = 4800 THEN _
  814.         ZBaudRateDivisor = &H18 _
  815.      ELSE IF ComSpeed! = 19200 THEN _
  816.         ZBaudRateDivisor = &H6 _
  817.      ELSE IF ComSpeed! = 38400 THEN _
  818.         ZBaudRateDivisor = &H3
  819.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  820.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  821.      LineCntlStatus = INP(ZLineCntlReg)
  822.      MSBSave = INP(ZMSB)
  823.      OUT ZMSB,0
  824.      OUT ZLineCntlReg,LineCntlStatus OR 128
  825.      OUT ZLSB,LeastSignifByte
  826.      OUT ZMSB,MostSignifByte
  827.      OUT ZLineCntlReg,LineCntlStatus
  828.      OUT ZMSB,MSBSave
  829.      END SUB
  830. * REPLACING old line(s) by new
  831. * ------[ first line different ]------
  832. 2021 ZOutTxt$ = "To [All],S)ysop," + _
  833.                  LEFT$("D)istribution,",-14*EnableCC) + _
  834.                  " or Name (2 Char. Min )"                         'Pe Efnd Mod
  835.      CALL SkipLine (1)
  836.      ZSemiOnly = ZTrue
  837.      CALL PopCmdStack
  838.      IF NOT ZSysop THEN _                'SM091908
  839.         CALL SmartText(ZUserIn$,ZFalse,ZFalse)        'SM091908
  840.      IF LEN(ZUserIn$(ZAnsIndex)) > 30 THEN _
  841.         CALL QuickTPut1 ("30 Char. Max") : _
  842.         GOTO 2021
  843.      Found = ZTrue
  844.      IF ZWasQ = 0 THEN _
  845.          MsgTo$ = "ALL" : _    'Pe 12/08/91
  846.            GOTO 2032 _         'Pe 12/08/91
  847.      ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _
  848.           CALL AllCaps (ZWasDF$) : _
  849.           ZUserIn$(ZAnsIndex) = ZWasDF$ : _
  850.           MsgTo$ = ZWasDF$ : _                                       'Pe Efnd mod
  851.        IF ZWasDF$ = "A" THEN _
  852.              MsgTo$ = "ALL" _
  853.           ELSE IF ZWasDF$ = "S" THEN _
  854.              MsgTo$ = ZSysopFirstName$ + " " +ZSysopLastName$ _   'TS 04/14/09
  855.           ELSE IF ZWasDF$ = "D" AND EnableCC THEN _
  856.              GOTO 2025 _
  857.           ELSE MsgTo$ = ZWasDF$
  858.      GOTO 2032
  859. * REPLACING old line(s) by new
  860. 2026 ZFileName$ = ZDistriPath$ + ZFileName$ + ".LST"
  861.      CALL FindItX (ZFileName$,7)
  862.      IF NOT ZOK THEN _
  863.         CALL QuickTPUT1 (ZUserIn$ + " not found") : _
  864. * ------[ first line different ]------
  865.         ZMplPersUpload = ZFalse : _
  866.         GOTO 2024
  867.      ZNumHeaders = 0
  868.     ZMplPersUpload = ZTrue
  869.      CALL OpenWorkA (ZNodeWorkFile$)
  870.      WHILE NOT EOF(7)
  871.         CALL ReadDir (7,1)
  872.         CALL AllCaps (ZOutTxt$)
  873.         ZWasDF$ = ZOutTxt$
  874.         CALL WhoCheck (ZOutTxt$, Found, RcvrRecNum)
  875.         ZNumHeaders = ZNumHeaders + 1
  876.         CALL PrintWorkA (ZWasDF$ + "," + STR$(-RcvrRecNum*Found))
  877.      WEND
  878.      GOTO 2033
  879. * REPLACING old line(s) by new
  880. 2032 RcvrRecNum = 0
  881. * ------[ first line different ]------
  882.       ZMplPersUpload = ZFalse
  883.      IF MsgTo$ <> "ALL" THEN _
  884.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  885.            ZWasDF = INSTR(MsgTo$+" @"," @") : _
  886.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _
  887.            ZMplPersUpload = Ztrue : _                           'Pe 06/08/91
  888.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  889.            CALL QuickPeek (ZUserIn$(ZAnsIndex),MsgTo$,Found): _         'Pe Efnd mod
  890.            CALL AliasChk (MsgTo$,Found,UserNumFound) : _          'Mpl-ALias2
  891.             IF MsgTo$ = "" THEN EXIT SUB : _                             ' DD062502
  892.             IF NOT Found THEN _
  893.             CALL QuickTPut1 (MsgTo$ + " is not a local user on " + ZRBBSName$ + ",") : _ ' DD060101
  894.               ZLastIndex = 0 : _
  895.            ZMplPersUpload = ZFalse : _                          'Pe 06/08/91
  896.               RcvrRecNum = 0 : _
  897.               IF NOT ZReply THEN _
  898.                  ZOutTxt$ = "Send anyway (Y,[N])" : _
  899.                  ZTurboKey = -ZTurboKeyUser : _
  900.                  ZLastIndex = 0 : _
  901.                  GOSUB 2034 : _
  902.                  IF NOT ZYes THEN _
  903.                     GOTO 2021
  904.      IF MsgTo$ = Temp$ THEN _
  905.         ZOutTxt$ = "Really send this to YOURSELF (Y,[N])" : _
  906.         ZLastIndex = 0 : _
  907.         GOSUB 2034 : _
  908.         IF NOT ZYes THEN _
  909.            MsgTo$ = ""
  910.      CALL OpenWorkA (ZNodeWorkFile$)
  911.      CALL PrintWorkA (MsgTo$ + "," + STR$(RcvrRecNum))
  912.      CLOSE 2
  913.      ZNumHeaders = ZNumHeaders + 1
  914.      IF EnableCC AND (NOT ZReply) AND MsgTo$ <> "ALL" AND _
  915.         MsgTo$ <> "" AND LEFT$(MsgTo$,4) <> "ALL " AND _
  916.         (NOT ZSysopComment) AND (NOT ZSysopMsg) THEN _
  917.            ZOutTxt$ = "Carbon copy to another (Y,[N])" : _
  918.            CALL PopCmdStack : _
  919.            IF ZYes THEN _
  920.               GOTO 2021
  921. * REPLACING old line(s) by new
  922. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  923. ' $PAGE
  924. '
  925. '  NAME    -- WhoCheck
  926. '
  927. '  INPUTS  --   PARAMETER                    MEANING
  928. '              WhoFind$                User to find
  929. '
  930. '  OUTPUTS --  WhoFound                Whether user found
  931. '              UserNumFound           Record # of user
  932. '
  933. '  PURPOSE --  Validate that user record exists.  Sysop
  934. '              counted as found even if lack user record.
  935. '
  936.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  937.      UserNumFound = 0
  938.      IF ZStartHash <> 1 THEN _
  939.         WhoFound = ZTrue : _
  940.         EXIT SUB
  941.      Work128$ = ZUserRecord$
  942.      WhoFound = ZFalse
  943.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  944.                 INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0)
  945. * ------[ first line different ]------
  946.      CALL OpenUser (ZHighestUserRecord)
  947.      FIELD 5, 128 AS ZUserRecord$
  948.      IF ToSysop THEN _
  949.         WasX$ = ZSecretName$ _
  950.      ELSE WasX$ = WhoFind$
  951.      ZWasDF = INSTR(WasX$+"@","@")
  952.      WasX$ = LEFT$(WasX$,ZWasDF)
  953.      IF LEN(WasX$) > 1 THEN _
  954.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  955.                        0,0,ZHighestUserRecord,WhoFound,_
  956.                        UserNumFound,ZWasSL)
  957.      LSET ZUserRecord$ = Work128$
  958.      IF NOT WhoFound THEN _
  959.         IF ToSysop THEN _
  960.            WhoFound = ZTrue 
  961.      END SUB
  962. * REPLACING old line(s) by new
  963. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  964. ' $PAGE
  965. '
  966. '  NAME    -- KillMsg
  967. '
  968. '  INPUTS  --     PARAMETER                    MEANING
  969. '              MsgToKill                   MESSAGE NUMBER TO KILL
  970. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  971. '
  972. '  OUTPUTS --  NONE
  973. '
  974. '  PURPOSE --  To kill/delete old or unnecessary messages
  975. '
  976. * ------[ first line different ]------
  977.      SUB KillMsg (MsgToKill,ActiveMessages,ZconfName$) STATIC     'Pe 05/29/91
  978.      FIELD #1,128 AS ZMsgRec$
  979.      WasQX = 1
  980.      NumHeaders = 0
  981. * REPLACING old line(s) by new
  982. 5503 IF SignTime = 1 THEN _
  983.         ZOutTxt$ = "Withdraw" _
  984.      ELSE ZOutTxt$ = "Deposit"
  985.      Temp$ = ZOutTxt$ + " how many mins"
  986.      CALL ChangeInt (ZFalse,Temp$,Temp,0,Maxtime)
  987.      IF ZWasQ = 0 OR ZTestedIntValue = 0 THEN _
  988.         GOTO 5501
  989.      ZTestedIntValue = SignTime * ZTestedIntValue
  990.      CALL ChkAddedTime (ZTestedIntValue)
  991.      IF ZTestedIntValue = 0 THEN _
  992.         GOTO 5501
  993.      ZSecsPerSession! = ZSecsPerSession! + (ZTestedIntValue * 60)
  994.      ZElapsedTime = ZElapsedTime - ZTestedIntValue
  995.      ZGlobalBankTime = ZGlobalBankTime - ZTestedIntValue
  996. * ------[ first line different ]------
  997.      ZBankTime = ZGlobalBankTime   'Pe 11/02/91
  998.      GOSUB 5507
  999.      GOTO 5501
  1000. * REPLACING old line(s) by new
  1001. 5509 GOSUB 5507
  1002. * ------[ first line different ]------
  1003.      END SUB
  1004. * REPLACING old line(s) by new
  1005. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  1006. ' $PAGE
  1007. '
  1008. '  NAME    -- DefaultU
  1009. '
  1010. '  INPUTS  --     PARAMETER                    MEANING
  1011. * ------[ first line different ]------
  1012. '             ZFullScreenEditor     'Pe 09/02/91 AnsiEd Mod
  1013. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  1014. '             ZCheckBulletLogon
  1015. '             ZExpertUser
  1016. '             ZWasGR
  1017. '             ZLastMsgRead
  1018. '             ZLineFeeds
  1019. '             ZNulls
  1020. '             ZPageLength
  1021. '             ZPromptBell
  1022. '             ZRegDate$
  1023. '             ZReqQuesAnswered
  1024. '             ZRightMargin
  1025. '             ZSkipFilesLogon
  1026. '             ZTimesLoggedOn
  1027. '             ZUpperCase
  1028. '             ZUserOption$
  1029. '             ZUserTextColor          Ansi of color (31-37)
  1030. '             ZUserXferDefault$
  1031. '
  1032. '  OUTPUTS--  USER.OPTONS$
  1033. '
  1034. '  PURPOSE --  To update the user's record with their options.
  1035. '  Meaning of graphics preference stored is as follows: where # is
  1036. '  value stored for the color.  E.g. if graphics perference for text
  1037. '  files is color, and preference for normal text is light yellow,
  1038. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  1039. '  Blue, Purple, Cyan, and White.
  1040. '
  1041. '             normal                  bold
  1042. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  1043. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  1044. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  1045. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  1046. '
  1047.      SUB DefaultU STATIC
  1048.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  1049.             -4 * ZNulls               -8 * ZUpperCase _
  1050.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  1051.            -64 * ZSkipFilesLogon    -128 * ZFullScreenEditor _
  1052.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  1053.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser _
  1054.          -4096 * ZFileWaiting
  1055.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  1056.      IF WasX < 1 OR WasX > 255 THEN _
  1057.         WasX = 48
  1058.      LSET ZUserOption$ = _
  1059.         MKI$(ZTimesLoggedOn) + _
  1060.         MKI$(ZLastMsgRead) + _
  1061.         ZUserXferDefault$ + _
  1062.         CHR$(WasX) + _
  1063.         MKI$(ZRightMargin) + _
  1064.         MKI$(ZWasA) + _
  1065.         ZRegDate$ + _
  1066.         CHR$(ZPageLength) + _
  1067.         ZEchoer$
  1068.      END SUB
  1069. * REPLACING old line(s) by new
  1070. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  1071. ' $PAGE
  1072. '
  1073. '  NAME    -- WhosOn
  1074. '
  1075. '  INPUTS  --     PARAMETER                    MEANING
  1076. '                NumNodes                   # of nodes to check
  1077. '                ZActiveMessageFile$        Current message file
  1078. '                ZOrigMsgFile$              Main msg file
  1079. '
  1080. '  OUTPUTS --  None
  1081. '
  1082. '  PURPOSE --  To display who is on each node.
  1083. '
  1084.      SUB WhosOn (NumNodes) STATIC
  1085.      WasA1$ = ZActiveMessageFile$
  1086.      ZActiveMessageFile$ = ZOrigMsgFile$
  1087.      CALL OpenMsg
  1088.      FIELD 1, 128 AS ZMsgRec$
  1089.      FOR NodeIndex = 2 TO NumNodes + 1
  1090.         GET 1,NodeIndex
  1091.         ZOutTxt$ = ZFG1$ + "Node" + _
  1092.              STR$(NodeIndex - 1) + ZFG2$
  1093. * ------[ first line different ]------
  1094.         RecIndex = VAL(MID$(ZMsgRec$,44,2))
  1095.         IF RecIndex >= 0 THEN _
  1096.            RecIndex = -1
  1097.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  1098.               " BPS: "
  1099.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  1100.            ZWasY$ = "SYSOP" + SPACE$(21) _
  1101.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  1102.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  1103. '* ------[ first line different ]------
  1104.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN                          ' CHAT0805
  1105.            CALL SaveUserActivity(WhatTheyDoin$, NodeIndex, ZTrue)    ' CHAT0813
  1106.            IF WhatTheyDoin$ = "C" THEN                               ' CHAT0813
  1107.               WasAX$ = WasAX$ + ZFG4$ + "(is using Chat System)"     ' CHAT0813
  1108.             ELSEIF WhatTheyDOin$ = "F" THEN                          ' CHAT0813
  1109.               WasAX$ = WasAX$ + ZFG4$ + "(is using File System)"     ' CHAT0813
  1110.             ELSEIF WhatTheyDoin$ = "M" THEN                          ' CHAT0813
  1111.               WasAX$ = WasAX$ + ZFG4$ + "(using Message System)"     ' CHAT0813
  1112.             ELSE                                                     ' CHAT0813
  1113.               WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)         ' CHAT0813
  1114.            END IF                                                    ' CHAT0813
  1115.          ELSE                                                        ' CHAT0805
  1116.            WasAX$ = WasAX$ + ZFG4$ + "(has opened a door)"           ' CHAT0805
  1117.         END IF                                                       ' CHAT0805
  1118. 'Pe 02/29/92
  1119.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  1120.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  1121.                 WasAX$ _
  1122.              ELSE ZOutTxt$ = ZOutTxt$ + _
  1123.                        " Offline at " + _
  1124.                        WasAX$
  1125.         CALL QuickTPut1 (ZOutTxt$)
  1126.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  1127.         IF ZNo THEN _
  1128.            NodeIndex = NumNodes + 2
  1129.      NEXT
  1130.      ZActiveMessageFile$ = WasA1$
  1131.      CALL QuickTPut (ZEmphasizeOff$,0)
  1132.      END SUB
  1133. * REPLACING old line(s) by new
  1134. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  1135. ' $PAGE
  1136. '
  1137. '  NAME    -- RecoverMsg
  1138. '
  1139. '  INPUTS  --     PARAMETER                    MEANING
  1140. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  1141. '               FirstMsgRecord        RECORD # FOR First MSG
  1142. '
  1143. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  1144. '                                         SET TO -1 IF No ERROR
  1145. '
  1146. '  PURPOSE --  To recover deleted messages.  Note that this is only
  1147. '              possible if you have not compressed your message file
  1148. '              using config.
  1149. '
  1150. * ------[ first line different ]------
  1151.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) STATIC 'Pe 06/09/91
  1152.       FIELD #1,128 AS ZMsgRec$
  1153.       MsgRec = FirstMsgRecord
  1154. * REPLACING old line(s) by new
  1155. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  1156. * ------[ first line different ]------
  1157.                            EXIT SUB
  1158. CALL QuickTPut1 (ZCrLF$ +ZFG1$ + STR$(MinsRemaining)+ ZFG2$ + _
  1159.                 " min left Today" +ZCrLF$ +" Banked Time.  " + ZFG1$+_
  1160.                   STR$(ZGlobalBankTime) + ZFG2$+" minutes.")
  1161. Call QuickTput1  (ZFG3$ +" "+ ZFirstName$ + ZFG2$ + ", Thanks for calling "+_
  1162.                   ZFG1$ +" " + ZOrigRBBSName$ +ZFG2$ +" please call again!" + _
  1163.                    ZColorReset$)
  1164.       CALL DelayTime (8 + ZBPS)
  1165.       END SUB
  1166. * REPLACING old line(s) by new
  1167. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  1168. ' $PAGE
  1169. '  NAME    -- DosExit
  1170. '
  1171. '  INPUTS  -- PARAMETER             MEANING
  1172. '             ZComPort$
  1173. '             ZDoorsTermType
  1174. '             ZMultiLinkPresent
  1175. '             ZRBBSBat$
  1176. '             ZRedirectIOMethod
  1177. '             ZUseDeviceDriver$
  1178. '
  1179. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  1180. '                                      ZRCTTYBat$
  1181. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  1182. '
  1183. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  1184. '             exit to DOS for the remote RBBS-PC sysop
  1185. '
  1186.       SUB DosExit STATIC
  1187. * ------[ first line different ]------
  1188. * INSERTING new line(s)
  1189. 10940 ZOutTxt$ = "Exit To Dos Using a DOOR (Y,[N])"
  1190.             ZTurboKey = -ZTurboKeyUser
  1191.             CALL TGet
  1192.             CALL AllCaps (ZUserIn$)
  1193.     IF ZYES THEN_
  1194.        GOTO 10955
  1195. '
  1196.       ZOutTxt$(1) = "ECHO OFF"
  1197.       IF ZUseDeviceDriver$ <> "" THEN _
  1198.          Port$ = ZUseDeviceDriver$ _
  1199.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  1200.       IF ZRedirectIOMethod THEN _
  1201.          ZFF = 5 : _
  1202.          ZOutTxt$(2) = "CTTY " + _
  1203.                  Port$ : _
  1204.          ZOutTxt$(3) = ZDiskForDos$ + _
  1205.                  "COMMAND" : _
  1206.          ZOutTxt$(4) = "CTTY CON" : _
  1207.          ZOutTxt$(5) = ZRBBSBat$ _
  1208.       ELSE ZFF = 3 : _
  1209.            ZOutTxt$(2) = ZDiskForDos$ + _
  1210.                    "COMMAND >" + _
  1211.                    Port$ + _
  1212.                    " <" + _
  1213.                    Port$ : _
  1214.            ZOutTxt$(3) = ZRBBSBat$
  1215. * REPLACING old line(s) by new
  1216. 10950 CALL AMorPM
  1217. * ------[ first line different ]------
  1218.      CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  1219.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  1220.       CALL QuickTPut1 ("SysOp in Remote Console Mode")
  1221.       CALL RBBSExit (ZOutTxt$(),ZFF)
  1222.  
  1223. '
  1224. * INSERTING new line(s)
  1225. 10955 ZOutTxt$ = "Enter Name of DOOR to use including Extension"  'Pe 10/18/90
  1226.             CALL TGet
  1227.             CALL AllCaps (ZUserIn$)
  1228. IF ZUserIn$ = "" or ZWasQ = 0 then_
  1229.    GOTO 10940
  1230.     ZWasZ$ = ZUserIn$
  1231.      CALL DoorExit (ZFalse)
  1232.       END SUB
  1233. * REPLACING old line(s) by new
  1234. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  1235.       IF ZErrCode > 0 THEN _
  1236.          IF ReqDoorsDef THEN _
  1237.             EXIT SUB _
  1238.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  1239.               GOTO 10989
  1240.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  1241.          GOTO 10985
  1242.       CALL CheckInt (ZOutTxt$(2))
  1243.       IF ZErrCode > 0 THEN _
  1244.          ZErrCode = 0 : _
  1245.          GOTO 10985
  1246.       IF ZUserSecLevel < ZTestedIntValue THEN _
  1247.          CALL QuickTPut1 ("Insufficient security for door") : _
  1248.          EXIT SUB
  1249.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  1250.       CALL FindIt (WasX$)
  1251.       IF NOT ZOK THEN _
  1252.          GOTO 10986
  1253.       ZFileName$ = ZOutTxt$(3)
  1254.       ExitMethod$ = ZOutTxt$(4)
  1255.       ExitTemplate$ = ZOutTxt$(5)
  1256.       ZDoorDisplay$ = ZOutTxt$(7)
  1257. * ------[ first line different ]------
  1258.       DoorTime$ = ZOutTxt$(8)
  1259.       CALL AskUsers
  1260.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  1261.       CALL MetaGSR (ExitTemplate$,ZFalse)
  1262.       ExitTo$ = ExitTemplate$
  1263.       GOTO 10989
  1264. * REPLACING old line(s) by new
  1265. 10989 IF ZTransferFunction = 3 THEN _
  1266.          ZWasY$ = "Registration" _
  1267.       ELSE ZWasY$ = ZDooredTo$
  1268. * ------[ first line different ]------
  1269.       ZOutTxt$ = " Swapping " +ZOrigRBBSName$ + " out and " + _
  1270.                      ZWasY$ + _
  1271.                      " door in... "
  1272.       ZSubParm = 5
  1273.       CALL TPut
  1274.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  1275.       CALL DoorInfo
  1276.       IF ExitMethod$ = "S" THEN _
  1277.          ZExitToDoors = ZTrue : _         'Pe 04/20/92
  1278.          CALL UpdateU (ZTrue) : _         'Pe 04/20/92 
  1279.          Call GetTime : _
  1280.          Call SaveProf (1) : _            'Pe 04/20/92
  1281.          CLOSE 4,5 : _
  1282.          CALL ShellExit (ExitTemplate$) : _
  1283.          ZPrevCaller$ = "" : _
  1284.          CALL SetCall : _                  'Pe 04/28/92
  1285.          CALL ReadProf : _                 'Pe 04/20/92  
  1286.          CALL BufFile (ZDoorDisplay$,WasX) : _
  1287.          ZExitToDoors = ZFalse _
  1288.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  1289.                   "COMMAND /C " + _
  1290.                   ExitTo$ : _
  1291.            ZOutTxt$(2) = ZRBBSBat$ : _
  1292.            CALL RBBSExit (ZOutTxt$(),2)
  1293.     CALL SetSysOp : _
  1294.     IF ZWasA THEN _
  1295.      ZActiveUserName$ = ZSysopFirstName$ + " " + ZSysopLastName$ : _ 'TS041492
  1296.      ZFirstName$ = ZSysopFirstName$                                  'TS041492
  1297.       END SUB
  1298. * REPLACING old line(s) by new
  1299. 10991 ' $SUBTITLE: 'DoorInfo -- Write info for doors to file'
  1300.       SUB DoorInfo STATIC
  1301.       CLOSE 2
  1302.       OPEN "O",2,"DORINFO" + _
  1303.                  ZNodeFileID$ + _
  1304.                  ".DEF"
  1305.       PRINT #2,ZRBBSName$
  1306.       PRINT #2,ZSysopFirstName$
  1307.       PRINT #2,ZSysopLastName$
  1308.       IF ZLocalUser THEN _
  1309.          PRINT #2,"COM0" _
  1310.       ELSE PRINT #2,ZComPort$
  1311. * ------[ first line different ]------
  1312. '      ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B"))
  1313. '      PRINT #2,ZTalkToModemAt$;ZUserIn$
  1314.       ZUserIn$ = MID$(ZBaudParity$, INSTR(ZBaudParity$, ","))        ' MB040401
  1315.       PRINT #2,ZTalkToModemAt$;" BAUD";ZUserIn$                      ' KG071101
  1316.       PRINT #2,ZNetworkType
  1317.       IF ZGlobalSysop THEN _
  1318.          PRINT #2,"SYSOP" : _
  1319.          PRINT #2,"" _
  1320.       ELSE PRINT #2,OrigFirstName$ : _        'Lk Alias fix
  1321.            PRINT #2,ZLastName$
  1322.       PRINT #2,ZCityState$
  1323.       PRINT #2,ZWasGR
  1324.       PRINT #2,ZUserSecLevel
  1325.       CALL TimeRemain (MinsRemaining)
  1326.       CALL CheckInt (DoorTime$)
  1327.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  1328.          IF MinsRemaining > ZTestedIntValue THEN _
  1329.             MinsRemaining = ZTestedIntValue
  1330.       PRINT #2,INT(MinsRemaining)
  1331.       PRINT #2,ZFossil
  1332.       CLOSE 2
  1333.       Call DoorSys                                                'ER 06/17/92
  1334.       END SUB
  1335. * REPLACING old line(s) by new
  1336. 10994 CLOSE 3
  1337.       ZExitToDoors = ZTrue
  1338.       IF NOT ZFossil THEN _
  1339.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  1340. * ------[ first line different ]------
  1341. * REPLACING old line(s) by new
  1342. 12880 ZParseOff = ZTrue
  1343.       ZOutTxt$ = Ques$
  1344.       CALL PopCmdStack
  1345.       IF ZSubParm = -1 THEN _
  1346.          GOTO 12882
  1347.       IF ZWasQ = 0 THEN _
  1348.          GOTO 12880
  1349.       IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
  1350.          ZLastIndex = 0 : _
  1351.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  1352.          GOTO 12880_
  1353.       ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
  1354.               ZLastIndex = 0 : _
  1355.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  1356.               GOTO 12880
  1357.       Ans$ = ZUserIn$(ZAnsIndex)
  1358.       IF ZAnsIndex < ZLastIndex THEN _
  1359.          GOTO 12881
  1360.       ZOutTxt$ = ZUserIn$(ZAnsIndex) + _
  1361.            ", right ([Y],N)"
  1362.       ZTurboKey = -ZTurboKeyUser
  1363.       ZSubParm = 1
  1364.       CALL TGet
  1365.       IF ZSubParm = -1 THEN _
  1366.          GOTO 12882
  1367.       IF ZNo THEN _
  1368. * ------[ first line different ]------
  1369.        GOTO 12880
  1370. * REPLACING old line(s) by new
  1371. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  1372. ' $PAGE
  1373. '
  1374. '  NAME    -- CheckRatio
  1375. '
  1376. '  INPUTS  --   PARAMETER                    MEANING
  1377. '               TellUser           TELL USER THEIR RATIO
  1378. '               ZDnlds             FILES DOWNLOADED
  1379. '               ZDLBytes!          BYTES DOWNLOADED
  1380. '               ZUplds             FILES UPLOADED
  1381. '               ZULBytes!          BYTES UPLOADED
  1382. '
  1383. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  1384. '
  1385. '  PURPOSE -- To determine whether the users violated
  1386. '             their upload to download restriction
  1387. '
  1388.       SUB CheckRatio (TellUser) STATIC
  1389.       ZOK = ZTrue
  1390. * ------[ first line different ]------
  1391.  IF ZFreeDnld THEN _
  1392.        GOTO 20110
  1393. '
  1394. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  1395. '
  1396.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  1397.          Method$ = "Bytes" : _
  1398.          ULWork# = ZULBytes! : _
  1399.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  1400.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  1401.          Method$ = "Files" : _
  1402.          ULWork# = ZUplds : _
  1403.          DLWork# = ZDnlds + ZDownFiles
  1404.       IF ULWork# < ZInitialCredit# THEN _
  1405.          ULWork# = ZInitialCredit#
  1406.       IF ZByteMethod = 2 THEN _
  1407.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  1408.       IF ZByteMethod = 3 THEN _
  1409.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  1410. '
  1411.       Ratio# = 0
  1412.       RatioSuffix$ = ":0"
  1413.       IF ULWork# > 0 THEN _
  1414.          Ratio# = (DLWork# / ULWork#) : _
  1415.          RatioSuffix$ = ":1"
  1416.       IF ZByteMethod > 1 THEN _
  1417.  ZOutTxt$ =  "Today's Downloaded Files: " + STR$(ZDLToday! + ZDownFiles)+ZCrLf$ + _
  1418.              "Number of Bytes Today  : " + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  1419.          ZSubParm = 5 : _
  1420.          CALL TPut : _
  1421.          CALL SkipLine (1) : _
  1422.          GOTO 20100
  1423.       WasX$ = STR$(Ratio#)
  1424.       X = INSTR(WasX$,".")
  1425.       IF X > 0 THEN _
  1426.          WasX$ = LEFT$(WasX$,X+1)
  1427. ZOutTxt$ = ZFG1$ + Method$ + " Downloaded: " + ZFG2$ +STR$(DLWork#)+ZCrLf$+ _
  1428.            ZFG3$ + Method$ + " Uploaded  : " + ZFG2$ +STR$(ULWork#) + ZCrLf$
  1429. ZOutTxt$ = ZoutTxt$ +  ZFG4$ + "Todays Downloaded Files: " + ZFG1$ + _
  1430.           STR$(ZDLToday! + ZDownFiles) + ZCrLf$ +"Ratio  : " +ZFG3$ + _
  1431.                              WasX$ + RatioSuffix$ +ZEmphasizeOff$
  1432.          ZSubParm = 5
  1433.          CALL TPut        'Pe 02/16/90
  1434. '
  1435. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  1436. '
  1437. * REPLACING old line(s) by new
  1438. * ------[ first line different ]------
  1439. 20100   IF NOT ZEnforceRatios OR ZRatioRestrict# <= 0 THEN _
  1440.          GOTO 20110                                               'Pe 02/16/90
  1441.  IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  1442.          EXIT SUB
  1443.       IF ZByteMethod <= 1 THEN _
  1444.          GOTO 20105
  1445.       IF Today# < 0 THEN _
  1446.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  1447.               STR$(ZRatioRestrict#) + " " + _
  1448.               Method$ + " Reached" : _
  1449.          ZOK = ZFalse : _
  1450.       CALL DelayTime (3) _  'Pe 02/03/90
  1451.       ELSE ZOutTxt$ = "Download balance:" + _
  1452.                 STR$(Today#) + _
  1453.                 " " + _
  1454.                 Method$ : _
  1455.            ZOK = ZTrue
  1456.       ZSubParm = 5
  1457.       CALL TPut
  1458.       CALL SkipLine(1)
  1459.       EXIT SUB
  1460. '
  1461. * REPLACING old line(s) by new
  1462. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  1463.          ZOK = ZFalse : _
  1464. * ------[ first line different ]------
  1465.            ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  1466.               STR$(ZRatioRestrict#) + _
  1467.               ":1 " + _
  1468.               Method$ + " exceeded" + CHR$(7) : _
  1469.          ZSubParm = 5 : _
  1470.          CALL TPut : _
  1471.          Call DelayTime (4) : _      'Pe 06/13/91
  1472.          ZOutTxt$ = "Minimum upload of" + _
  1473.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  1474.               / ZRatioRestrict#) + 1)) + _
  1475.               + " " + Method$ + " required to download" _
  1476.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  1477.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  1478.                 " " + Method$
  1479.       ZSubParm = 5
  1480.       CALL TPut
  1481.      CALL SkipLine (1)
  1482. * REPLACING old line(s) by new
  1483. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1484.       CALL UnMarkItems (ZMarkedFiles$,ZAnsIndex, ZLastIndex,Temp,ZFalse)
  1485.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  1486.       WasZ$ = ZWasZ$
  1487.       CALL AllCaps (ZWasZ$)
  1488.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  1489.       IF Ext$ = "" THEN _
  1490.          Ext$ = ZDefaultExtension$ : _
  1491.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  1492. * ------[ first line different ]------
  1493.       ZLastExt$ = Ext$                                   'Pe 08/12/91
  1494.       ZFileNameHold$ = ZWasZ$
  1495.       ZFileName$ = ZWasZ$
  1496.       WasI = 1                                        'Pe 04/21/92
  1497.       CALL BadFile (Prefix$,BadFileNameIndex)
  1498.       ON BadFileNameIndex GOTO 20144,20146,20147
  1499. * REPLACING old line(s) by new
  1500. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V")
  1501.       IF ZOK THEN _
  1502.          GOTO 20148
  1503. * ------[ first line different ]------
  1504. If ZPersonalDnld Then _                                        'Pe 08/12/91
  1505. ZFileName$ = ZPersonalDrvPath$ + ZWasZ$ : _                    'Pe 08/12/91
  1506. CALL FindFile (ZFileName$,ZOK)                                 'Pe 08/12/91
  1507.  IF ZOK THEN _                                                 'Pe 08/12/91
  1508.     GOTO 20148                                                 'Pe 08/12/91
  1509.    ZWasZ$ = ZFileName$                                         'Pe 04/21/92
  1510.     CALL BreakFileName (ZFileName$,DR$,Prefix$,Ext$,ZFalse)    'Pe 04/21/92
  1511.     WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".")          'Pe 04/21/92
  1512.      IF WasJ = 0 THEN _                                        'Pe 04/21/92
  1513.         GOTO 20146                                             'Pe 04/21/92
  1514.          Check$ = MID$(ZCompressedExt$,WasI,WasJ-1)            'Pe 04/21/92
  1515.        WasI = WasI + WasJ                                      'Pe 04/21/92
  1516.       ZFileName$ = Prefix$ + "." + Check$                      'Pe 04/21/92
  1517.       ZLastExt$ = Check$                                       'Pe 04/21/92
  1518.      ZFileNameHold$ = ZFileName$                               'Pe 04/21/92
  1519.    GOTO 20145                                                  'Pe 04/21/92
  1520. * REPLACING old line(s) by new
  1521. * ------[ first line different ]------
  1522. 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT"   'Pe 09/25/91
  1523.       CALL FindIt (WasX$)
  1524.       IF NOT ZOK THEN _
  1525.          GOTO 20170                 'Pe 11/02/91
  1526. '
  1527. '  adds FileSec to ViewArc commands
  1528. '
  1529.       CALL OpenWork (2,ZFileSecFile$)
  1530.       IF ZErrCode = 53 THEN _
  1531.          CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
  1532.          ZErrCode = 0 : _
  1533.          GOTO 20165
  1534. * DELETING old line(s)
  1535. 20150
  1536. * INSERTING new line(s)
  1537. 20160 IF EOF(2) THEN _
  1538.          GOTO 20165
  1539.       CALL ReadParms (ZWorkAra$(),3,1)
  1540.       IF ZErrCode <> 0 THEN _
  1541.          CALL UpdtCalr (ZFileSecFile$ + " error in file!",2) : _
  1542.          GOTO 20165
  1543.      CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
  1544.       IF NOT ZOK THEN _
  1545.          GOTO 20160
  1546.         IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  1547.          GOTO 20162
  1548.       FilePswd$ = ZWorkAra$(3)
  1549.       IF FilePswd$ = "" THEN _
  1550.          GOTO 20165
  1551.       CALL AraAllCaps (ZUserIn$(),1)
  1552.       IF ZUserIn$(1) = FilePswd$ THEN _
  1553.          GOTO 20165
  1554.       ZOutTxt$ = "Enter PASSWORD to view " + _
  1555.            ZFileNameHold$
  1556.             ZSubParm = 1
  1557.          Call TGet
  1558.       IF ZSubParm < 0 THEN _
  1559.          Exit Sub
  1560.       IF ZWasQ = 0 THEN _
  1561.          RETURN
  1562.       CALL AllCaps (ZUserIn$(1))
  1563.       IF ZUserIn$(1) = FilePswd$ THEN _
  1564.          GOTO 20165
  1565. 20162 ZViolation$ = "View " + _
  1566.                    ZFileName$
  1567.       Call QuickTPut1 ("Protected File...!")
  1568. 20163 CALL SecViolation
  1569.       IF ZDenyAccess THEN _
  1570.          ZFileSysParm = 4
  1571.       RETURN
  1572. '
  1573. '  End of changes
  1574. '
  1575. 20165 CALL QuickTPut1 (ZFileNameHold$ + " has these files")       'Pe 09/25/91
  1576.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  1577.       CALL OpenWork (2,WasX$)                                     'Pe 11/02/91
  1578.       CALL ReadDir (2,1)
  1579.       IF EOF(2) THEN _
  1580.          ZWasZ$ = ZOutTxt$ : _
  1581.          ZGSRAra$(1) = ZFileName$ : _
  1582.          ZGSRAra$(2) = ZArcWork$ _
  1583.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  1584.                 " " + ZArcWork$ + " " + ZGSRAra$(3)
  1585.       CALL ShellExit (ZWasZ$)
  1586.       CALL BufFile (ZArcWork$,WasX)
  1587.       CALL ViewTxt        'located in Rbbssub1.bas
  1588.       RETURN
  1589. 20170  CALL QuickTPut1 ("View for "+Ext$+" not implemented")    'Pe 11/02/91
  1590.          RETURN
  1591.       END SUB
  1592. * REPLACING old line(s) by new
  1593. 20245 SUB SetBPS (BaudTest!,BPS) STATIC
  1594. * ------[ first line different ]------
  1595.       IF BaudTest! = 2400 THEN _
  1596.          BPS = -4 _
  1597.       ELSE IF BaudTest! = 1200 OR BaudTest! = 1275 THEN _
  1598.          BPS = -3 _
  1599.       ELSE IF BaudTest! >= 7200 AND BaudTest! < 19200 THEN _
  1600.          GOTO 20246 _
  1601.       ELSE IF BaudTest! = 0 OR BaudTest! = 300 THEN _
  1602.          BaudTest! = 300 : _
  1603.          BPS = -1 _
  1604.       ELSE IF BaudTest! = 19200 THEN _
  1605.          BPS = -11 _
  1606.       ELSE IF BaudTest! = 38400 THEN _
  1607.          BPS = -12 _
  1608.       ELSE IF BaudTest! = 4800 THEN _
  1609.          BPS = -5 _
  1610.       ELSE BPS = 0
  1611.       EXIT SUB
  1612. * REPLACING old line(s) by new
  1613. 20246 IF BaudTest! = 14400 THEN _
  1614.          BPS = -9 _
  1615.       ELSE IF BaudTest! = 16800 THEN _
  1616.          BPS = -10 _
  1617.       ELSE IF BaudTest! = 7200 THEN _
  1618.          BPS = -6 _
  1619.       ELSE IF BaudTest! = 12000 THEN _
  1620.          BPS = -8 _
  1621.       ELSE BPS = -7       ' 9600
  1622.       END SUB
  1623. * ------[ first line different ]------
  1624.  
  1625. * INSERTING new line(s)
  1626. 20340 ' $SUBTITLE: 'QuickPeek - Easy find user to send message to'   ' DD062502
  1627. ' $PAGE                                                              ' DD062502                                                                     ' DD062502
  1628. '  NAME    -- QuickPeek - A Dan & Howard Mod - Dan Drinnon 1992      ' DD062502
  1629. '                                                                    ' DD062502
  1630. '  INPUTS  --     PARAMETER                    MEANING               ' DD062502
  1631. '                                                                    ' DD062502
  1632. '  OUTPUTS --     ZUserIn$                Search String User Input   ' DD062502
  1633. '                 MsgTo$                  Who Message is To          ' DD062502
  1634. '  PURPOSE -- Save User keystrokes when looking for message addressee' DD062502
  1635. '                                                                    ' DD062502
  1636.       SUB QuickPeek (ZUserIn$,MsgTo$,WhoFound)  Static               ' DD062502
  1637.       IF WhoFound = ZTrue THEN EXIT SUB                              ' DD062502
  1638.       ZLastDateTimeOnSave$ = ZLastDateTimeOn$                        ' DD062502
  1639.       UserInName$ = ZUserIn$                                         ' DD062502
  1640.       WhichUser = 1                                                  ' DD062502
  1641.       CALL OpenUser (ZHighestUserRecord)                             ' DD062502
  1642.       WHILE NOT EOF(5)                                               ' DD062502
  1643.          GET #5, WhichUser                                           ' DD062502
  1644.          TempMsgTo$ = ZUserName$                                     ' DD062502
  1645.          CALL TRIM (TempMsgTo$)                                      ' DD062502
  1646.          IF UserInName$ = TempMsgTo$ THEN EXIT SUB                   ' DD062502
  1647.          IF INSTR(TempMsgTo$,UserInName$) > 0 THEN                   ' DD062502
  1648.          ZSubParm = 1                                                ' DD062502
  1649.          ZOutTxt$ = "Send to: " + TempMsgTo$ + " (Y)es,[N])o,A)bort)" ' DD062502
  1650.          ZTurboKey = -ZTurboKeyUser                                  ' DD062502
  1651.          CALL PopCmdStack                                            ' DD062502
  1652.          IF ZSubParm = -1 THEN _                                     ' DD062502
  1653.             EXIT SUB                                                 ' DD062502
  1654.          ZWasZ$ = ZUserIn$(1)                                        ' DD062502
  1655.          CALL AllCaps (ZWasZ$)                                       ' DD062502
  1656.          IF ZWasZ$ = "A" THEN _                                      ' DD062502
  1657.             MsgTo$ = "" : _                                          ' DD062502
  1658.             WhoFound = ZFalse : _                                      DD062502
  1659.             EXIT SUB                                                 ' DD062502
  1660.          IF ZWasZ$ = "Y" THEN                                        ' DD062502
  1661.             MsgTo$ = TempMsgTo$                                      ' DD062502
  1662.             ZUserIn$ = TempMsgTo$                                    ' DD062502
  1663.             WhoFound = ZTrue                                         ' DD062502
  1664.             ZLastDateTimeOn$ = ZLastDateTimeOnSave$                  ' DD062502
  1665.             EXIT SUB                                                 ' DD062502
  1666.          ELSE                                                        ' DD062502
  1667.             WhichUser=WhichUser+1                                    ' DD062502
  1668.          END IF                                                      ' DD062502
  1669.          ELSE                                                        ' DD062502
  1670.             WhichUser=WhichUser+1                                    ' DD062502
  1671.          END IF                                                      ' DD062502
  1672.       WEND                                                           ' DD062502
  1673.       ZLastDateTimeOn$ = ZLastDateTimeOnSave$                        ' DD062502
  1674.       END SUB                                                        ' DD062502
  1675.